home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / scsh / scsh-read.scm < prev    next >
Text File  |  1995-10-13  |  4KB  |  126 lines
  1. ;;; Copyright (c) 1993, 1994 by Olin Shivers.
  2. ;;; #! comment read-macro
  3. ;;; no case-folding
  4. ;;; -flag is a symbol
  5.  
  6. ;;; #! means: skip chars until newline-bang-splat-newline. 
  7. ;;; For Unix script headers.
  8.  
  9. (define script-skip
  10.   (lambda (c port)
  11.     (read-char port)
  12.     (let lp ((state 0))
  13.       (let ((advance-if (lambda (look-for)
  14.               (let ((c (read-char port)))
  15.                 (if (eof-object? c)
  16.                 (error 
  17.              "EOF inside block comment -- #! missing a closing !#")
  18.                 (lp (cond ((char=? c look-for) (+ state 1))
  19.                       ((char=? c #\newline) 1)
  20.                       (else 0))))))))
  21.     (case state
  22.       ((0) (advance-if #\newline))
  23.       ((1) (advance-if #\!))    ; Found \n
  24.       ((2) (advance-if #\#))    ; Found \n!
  25.       ((3) (advance-if #\newline))    ; Found \n!#
  26.       ((4) (read port)))))))    ; Found \n!#\n -- done.
  27. ;         was sub-read ^
  28.  
  29. (define-sharp-macro #\! script-skip)
  30.  
  31.  
  32. ;;; Readme and readme are distinct symbols.
  33.  
  34. (define preferred-case (lambda (x) x))
  35.  
  36. ;;; These are now OK symbols: .. -geometry -O2 9x15 80x5+5+5 +Wn
  37.  
  38. (define (parse-token string port)
  39.   (if (let ((c (string-ref string 0)))
  40.     (or (char-numeric? c) (char=? c #\+) (char=? c #\-) (char=? c #\.)))
  41.       (cond ((string->number string))
  42.         ((string=? string ".") dot)
  43.         (else (string->symbol string)))
  44.       (string->symbol string)))
  45.  
  46.  
  47. ;;; | is now an OK symbol (for pipes).
  48.  
  49. (set-standard-syntax! #\| #f
  50.               (lambda (c port)
  51.             (parse-token (sub-read-token c port) port)))
  52.  
  53. (define bel (ascii->char 7))
  54. (define bs  (ascii->char  8))
  55. (define ff  (ascii->char 12))
  56. (define cr  (ascii->char 13))
  57. (define ht  (ascii->char  9))
  58. (define vt  (ascii->char 11))
  59.  
  60. ;;; Full ANSI C strings:
  61. ;;; - read as themselves: \\ \? \" \'
  62. ;;; - control chars:
  63. ;;;   \a alert (bell -- ^g)
  64. ;;;   \b backspace (^h)
  65. ;;;   \f form feed (^l)
  66. ;;;   \n newline (^j)
  67. ;;;   \r carriage return (^m)
  68. ;;;   \t tab (^i)
  69. ;;;   \v vertical tab (^k)
  70. ;;; - octal escapes \nnn
  71. ;;; - hex escapes \xnn
  72.  
  73. ;;; Is this the elegant thing to do? Too much might make it hard to shift
  74. ;;; to Unicode implementations. How about \^g for embedding control chars?
  75. ;;; And I haven't done anything about chars (as opposed to strings).
  76.  
  77. (set-standard-read-macro! #\" #t
  78.   (lambda (c port)
  79.     c ;ignored
  80.     (let* ((readc (lambda ()
  81.             (let ((c (read-char port)))
  82.               (if (eof-object? c)
  83.               (reading-error port "end of file within a string")
  84.               c))))
  85.        (read-digit (lambda (base base-name)
  86.              (let* ((c (readc))
  87.                 (d (- (char->ascii c) (char->ascii #\0))))
  88.                (if (and (<= 0 d) (< d base)) d
  89.                    (reading-error port
  90.                           (string-append "invalid "
  91.                                  base-name
  92.                                  " code in string.")
  93.                           d))))))
  94.  
  95.       (let loop ((l '()) (i 0))
  96.     (let ((c (readc)))
  97.       (cond ((char=? c #\\)
  98.          (let* ((c (readc))
  99.             (rc (case c
  100.                   ((#\\ #\" #\? #\') c)
  101.                   ((#\a) bel)
  102.                   ((#\b) bs)
  103.                   ((#\f) ff)
  104.                   ((#\n) #\newline)
  105.                   ((#\r) cr)
  106.                   ((#\t) ht)
  107.                   ((#\v) vt)
  108.                   ((#\0 #\1 #\2 #\3)
  109.                    (let* ((d1 (- (char->ascii c) (char->ascii #\0)))
  110.                       (d2 (read-digit 8 "octal"))
  111.                       (d3 (read-digit 8 "octal")))
  112.                  (ascii->char (+ (* 64 d1) (+ (* 8 d2) d3)))))
  113.                   ((#\x)
  114.                    (let ((d1 (read-digit 16 "hex"))
  115.                      (d2 (read-digit 16 "hex")))
  116.                  (ascii->char (+ (* 16 d1) d2))))
  117.                   (else
  118.                    (reading-error port
  119.                           "invalid escaped character in string"
  120.                           c)))))
  121.            (loop (cons rc l) (+ i 1))))
  122.         ((char=? c #\")
  123.          (reverse-list->string l i))
  124.         (else
  125.          (loop (cons c l) (+ i 1)))))))))
  126.